home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue27 / flist200 / FLIST200.ZIP / masksearch.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1997-09-25  |  8.1 KB  |  244 lines
  1. unit MaskSearch;
  2.  
  3. interface
  4. uses Classes,SysUtils,Windows,ShellAPI;
  5.  
  6. // String routines
  7. procedure GetShellFileInfo (FileName :TFileName; var ShFileInfo :TShFileInfo);
  8. function SizeStr (Size,Typ :integer ) :string;
  9. function AttrStr(Attr:integer):string;
  10. function GetTimeModified(a:tfiletime):string;
  11.  
  12. // File Search utility
  13. procedure setfilters (a:string;grep_list:tstringlist;findfile : boolean; MatchCase :boolean);
  14. function cmpmask(a:string;grep_list:tstringlist;findfile : boolean; MatchCase :boolean):boolean;
  15. function cmpfile(a:string;grep_list:tstringlist; MatchCase :boolean):boolean;
  16.  
  17. implementation
  18.  
  19. //
  20. // STRING ROUTINES
  21. //
  22. // Get Shell Info for the specified file
  23. procedure GetShellFileInfo (FileName :TFileName; var ShFileInfo :TShFileInfo);
  24. begin
  25.   ShGetFileInfo (PChar(FileName),0,ShFileInfo,SizeOf (ShFileInfo),
  26.                  shgfi_SysIconIndex or shgfi_Icon or
  27.                  shgfi_DisplayName or shgfi_TypeName or
  28.                  shgfi_SmallIcon);
  29. end;
  30.  
  31. // Convert Size for Sort
  32. function SizeStr (Size,Typ :integer ) :string;
  33. begin
  34.   if (Typ and faDirectory) = faDirectory then
  35.     Result := ''
  36.   else
  37.     Result := Format ('%10d',[Size]);
  38. end;
  39.  
  40. // returns a string with file attributes (DRSH)
  41. function AttrStr(Attr:integer):string;
  42. begin
  43.   Result := '';
  44.   if (Attr and file_attribute_Directory)  > 0 then Result := Result + 'D';
  45.   if (Attr and file_attribute_Archive)    > 0 then Result := Result + 'A';
  46.   if (Attr and file_attribute_Readonly)   > 0 then Result := Result + 'R';
  47.   if (Attr and file_attribute_System)     > 0 then Result := Result + 'S';
  48.   if (Attr and file_attribute_Hidden)     > 0 then Result := Result + 'H';
  49. //  if (Attr and FILE_ATTRIBUTE_COMPRESSED) > 0 then Result := Result + 'C';
  50.   if (Attr and file_attribute_Temporary)  > 0 then Result := Result + 'T';
  51. end;
  52.  
  53. // File Date & Time
  54. function GetTimeModified(a:tfiletime):string;
  55. // This function retrieves the last time, the given file was written to disk
  56. var
  57.   mtm :TSystemTime;
  58.   at  :TFileTime;
  59.   ds,ts:ShortString;
  60. begin
  61.   // Time must get converted, else there is an error of one hour
  62.   // Does anybody know what this function does ?
  63.   // Maybe something like summertime/wintertime (or what you call it out of Germany) ?
  64.   filetimetolocalfiletime(a,at);
  65.   filetimetosystemtime(at,mtm);
  66.   SetLength(ds, GetDateFormat(LOCALE_USER_DEFAULT, 0, @mtm, NIL, @ds[1], 255) - 1);
  67.   SetLength(ts, GetTimeFormat(LOCALE_USER_DEFAULT, time_noseconds, @mtm, NIL,
  68.                                                @ts[1], 255)  - 1);
  69.   Result:=ds+'  '+ts;
  70. end; // End getmod
  71.  
  72. function CaseAware (S :string; Match :boolean) :string;
  73. begin
  74.   if Match then
  75.     Result := S
  76.   else Result := AnsiLowerCase(S);
  77. end;
  78. //
  79. // Original File Search Routine by Marcus Stephany
  80. //
  81. procedure setfilters (a:string;grep_list:tstringlist;findfile : boolean; MatchCase :boolean);
  82. // fills the grep_list with the parts of 'a' (divided by ',' or ';')
  83. // findfile describes whether to use for find files or text in files
  84. // + aml modified : Match Case
  85.  
  86. var ct : integer;
  87. begin
  88.      grep_list.clear;
  89.      grep_list.sorted := false;
  90.      if a = '' then begin
  91.         grep_list.add('*');
  92.         exit;
  93.      end;
  94.      // replace all ',' by ';'
  95.      ct := pos (',',a);
  96.      while ct > 0 do begin
  97.            a[ct] := ';';
  98.            ct:=pos(',',a);
  99.      end;
  100.      if a[length(a)] <> ';' then a:=a+';';
  101.      // divide the string
  102.      ct := pos(';',a);
  103.      while ct > 0 do begin
  104.            grep_list.add(CaseAware(trim(copy(a,1,ct-1)),MatchCase));
  105.            a:=copy(a,ct+1,maxint);
  106.            ct:=pos(';',a);
  107.      end;
  108.      // replace a 'xxx' term (without a '.') with '*xxx*' (for compatibility
  109.      // with win95's file-search-dialog)
  110.      // only if findfile
  111.      if findfile then begin
  112.       if grep_list.count > 0 then for ct := 0 to pred(grep_list.count) do begin
  113.         a:=grep_list[ct];
  114.         if (pos('*',a) = 0) and (pos('?',a) = 0) and (pos('.',a) = 0) then
  115.            grep_list[ct]:='*'+a+'*'
  116.         else
  117.         if pos('.',a) = 0 then if a[length(a)] <> '*' then
  118.            grep_list[ct]:=a+'*';
  119.       end;
  120.      end;
  121.      grep_list.sorted := true;
  122.      grep_list.duplicates := dupignore;
  123. end;
  124.  
  125. function cmpmask1(a,b:string;findfile:boolean):boolean;
  126. // tests whether the string 'a' fits to the search mask in 'b'
  127. var sr             : string;
  128.     ps1,ps2,ps3    : integer;
  129.     dontcare       : boolean;
  130.     onechar        : char;
  131.     tmp_list       : tstrings;
  132. begin
  133.      result := true;
  134.      if b = '*' then exit; // fits always
  135.      if b = '*.*' then if pos('.',a) > 0 then exit; // fits, too
  136.      if (pos('*',b) = 0) and (pos('?',b)=0) then
  137.         if not findfile then begin
  138.            if pos(b,a) > 0
  139.               then exit;
  140.            // searched text was found (searchstring IN text)
  141.         end else
  142.            if a=b then exit;
  143.            // searched file was found (searchstring IS text)
  144.  
  145.  
  146.      result   := false;
  147.      if b = '' then exit;
  148.      try
  149.         tmp_list := tstringlist.create;
  150.         // divide partial strings ('?','*' or text) to tmp_list
  151.         repeat
  152.               onechar := b[1];
  153.               if (onechar='*') or (onechar='?') then begin
  154.                  tmp_list.add(onechar);
  155.                  delete(b,1,1);
  156.               end else begin
  157.                   ps1 := pos('?',b);
  158.                   if ps1 = 0 then ps1 := maxint;
  159.                   ps2 := pos('*',b);
  160.                   if ps2 = 0 then ps2 := maxint;
  161.                   if ps2 > ps1 then ps2 := ps1;
  162.                   tmp_list.add(copy(b,1,ps2-1));
  163.                   b:=copy(b,ps2,maxint);
  164.               end;
  165.         until b = '';
  166.         // now compare the string with the partial search masks
  167.         dontcare := false;
  168.         ps2      := 1;
  169.         if tmp_list.count > 0 then for ps1 := 0 to pred(tmp_list.count) do begin
  170.            sr := tmp_list[ps1];
  171.            if sr = '?' then begin
  172.               inc(ps2,1);
  173.               if ps2 > length(a) then exit;
  174.            end else
  175.            if sr = '*' then
  176.               dontcare := true
  177.            else begin
  178.                 if not dontcare then begin
  179.                    if copy(a,ps2,length(sr)) <> sr then exit;
  180.                    dontcare := false;
  181.                    ps2 := ps2+length(sr);
  182.                 end else begin
  183.                    ps3:= pos(sr,copy(a,ps2,maxint));
  184.                    if ps3 = 0 then exit;
  185.                    ps2 := ps3+length(sr);
  186.                    dontcare := false;
  187.                 end;
  188.            end;
  189.         end;
  190.         if not dontcare then if ps2 <> length(a)+1 then exit;
  191.         result := true;
  192.      finally
  193.             tmp_list.free;
  194.      end;
  195. end;
  196.  
  197. function cmpmask(a:string;grep_list:tstringlist;findfile:boolean; MatchCase :boolean):boolean;
  198. // tests whether the string 'a' fits to the search masks in grep_list
  199. var ct : integer;
  200. begin
  201.      result := true;
  202.      if a = '' then exit; // if no search string, the always return TRUE
  203.      a:=CaseAware(a,MatchCase);
  204.      result:=false;
  205.      if (grep_list = nil) or (grep_list.count < 1) then exit;
  206.      result := true;
  207.      for ct := 0 to pred(grep_list.count) do
  208.          if cmpmask1(a,grep_list[ct],findfile) then exit; // compare with the whole
  209.                                                           // grep_list until one fits
  210.      result := false;
  211. end;
  212.  
  213. function cmpfile(a:string;grep_list:tstringlist; MatchCase :boolean):boolean;
  214. // tests whether a file's contents fit to the specified mask;
  215. var
  216.    fl:string;
  217.    ts:tfilestream;
  218.    ct:integer;
  219. begin
  220.      result := true;
  221.      // different handling between filefind an textfind
  222.      // true if no or each text is wanted
  223.      if (grep_list.count < 1) or (grep_list[0] = '*') then exit;
  224.  
  225.      result := false;
  226.      try
  227.        ts := tfilestream.create(a,fmopenread or fmsharedenynone);
  228.      except
  229.        exit;
  230.      end;
  231.      try
  232.        setlength(fl,ts.size+1);
  233.        ts.position := 0;
  234.        ts.read(fl[1],ts.size);
  235.        ts.free;
  236.        result := cmpmask(CaseAware(fl,MatchCase),grep_list,false,MatchCase);
  237.      finally
  238.        setlength(fl,0);
  239.      end;
  240. end;
  241.  
  242.  
  243. end.
  244.